home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / egg / egg-sj3-client.el.z / egg-sj3-client.el
Encoding:
Text File  |  1998-05-21  |  38.1 KB  |  1,313 lines
  1. ;; Sj3 server interface for Egg
  2. ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp)
  3.  
  4. ;; This file is part of Egg on Mule (Multilingual Environment)
  5.  
  6. ;; Egg is distributed in the forms of patches to GNU
  7. ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
  8. ;; LICENSE which is distributed along with GNU Emacs by the
  9. ;; Free Software Foundation.
  10.  
  11. ;; Egg is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied
  13. ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  14. ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  15. ;; more details.
  16.  
  17. ;; You should have received a copy of the GNU EMACS GENERAL
  18. ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  19. ;; If not, write to the Free Software Foundation, 675 Mass
  20. ;; Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;;; Ported to XEmacs 2-December, 1997.
  23.  
  24. ;;;
  25. ;;; Mule - Sj3 server interface in elisp
  26. ;;;
  27.  
  28. (provide 'egg-sj3-client)
  29.  
  30. ;;;;  $B=$@5%a%b!(!((B
  31.  
  32. ;;;   Aug-4-94 by K.Ishii
  33. ;;;   Bug fixed in sj3-put-kata.
  34.  
  35. ;;;   Apr-6-94 by N.Tanaka 
  36. ;;;   Add version 2(japanese EUC) protocol
  37.  
  38. ;;;   Jun-16-93 by H.Shirasaki <sirasaki@rd.ecip.osaka-u.ac.jp>
  39. ;;;   In sj3-bunsetu-yomi-equal, typo fixed.
  40.  
  41. ;;;   Apr-6-93 by T.Saneto <sanewo@pdp.crl.sony.co.jp>
  42. ;;;   Bug fixed in sj3-bunsetu-yomi-equal.
  43.  
  44. ;;;   Mar-19-93 by K.Ishii
  45. ;;;   Changed sj3-server-dict-info for edit-dict
  46.  
  47. ;;;   Aug-6-92 by K.Ishii
  48. ;;;   $BF|K\8lH=Dj$K(B lc-jp $B$r;H$&$h$&$KJQ99(B
  49.  
  50. ;;;   Jul-30-92 by K.Ishii
  51. ;;;   $BD9$$J8>O$rJQ49$9$k$H$-$K5/$3$k(B "Args out of range" $B%(%i!<$N=$@5(B
  52. ;;;   $BEPO?$7$?F0;l$N:o=|$,$G$-$k$h$&$K(B sj3-server-dict-info $B$N=$@5(B
  53. ;;;   sj3serv $B$KEO$9%W%m%0%i%`L>$NJQ99(B
  54.  
  55. ;;;   Jun-2-92 by K.Ishii
  56. ;;;   Mule $BMQ$KJQ99(B
  57.  
  58. ;;;   Dec-12-91 by K.Ishii
  59. ;;;   $BJ8@a3X=,$,$&$^$/$G$-$J$$$3$H$,$"$k$?$a!"(Bsj3-result-buffer $B$rJQ99(B
  60. ;;;
  61. ;;;   sj3-get-stdy $B$G(B "Count exceed." $B%(%i!<$rNI$/5/$3$9$N$G:o=|(B
  62.  
  63. ;;;   Nov-26-91 by K.Ishii
  64. ;;;   sj3-server-open $B$G(B host_name $B$H(B user_name $B$rEO$9=gHV$N=$@5(B
  65. ;;;
  66. ;;;   sj3-server-henkan-next $B$r<B9T$7$F$h$/5/$3$k(B "Count exceed." $B$H$$$&(B
  67. ;;;   $B%P%0$N=$@5(B
  68. ;;;
  69. ;;;   sj3-server-henkan-next $B$G0l3gJQ49$HJ8@aJQ49$GBh0l8uJd$,0c$C$?>l9g(B
  70. ;;;   $B$K5/$3$k%P%0$N=$@5(B($B$3$l$KH<$$J8@a3X=,(B sj3-server-b-study $B$N=$@5(B)
  71.  
  72. ;;;
  73. ;;;  Sj3 daemon command constants
  74. ;;;
  75.  
  76. (defconst SJ3_OPEN          1  "$BMxMQ<TEPO?(B")
  77. (defconst SJ3_CLOSE         2  "$BMxMQ<T:o=|(B")
  78. ;;;
  79. (defconst SJ3_DICADD       11 "$B<-=qDI2C(B")
  80. (defconst SJ3_DICDEL       12 "$B<-=q:o=|(B")
  81. ;;;
  82. (defconst SJ3_OPENSTDY       21  "$B3X=,%U%!%$%k%*!<%W%s(B")
  83. (defconst SJ3_CLOSESTDY       22  "$B3X=,%U%!%$%k%/%m!<%:(B")
  84. (defconst SJ3_STDYSIZE       23  "")
  85. ;;;
  86. (defconst SJ3_LOCK         31 "$B<-=q%m%C%/(B")
  87. (defconst SJ3_UNLOCK       32 "$B<-=q%"%s%m%C%/(B")
  88. ;;;
  89. (defconst SJ3_BEGIN        41 "$BJQ493+;O(B")
  90. (defconst SJ3_BEGIN_EUC   111 "$BJQ493+;O(B")
  91. ;;;
  92. (defconst SJ3_TANCONV      51 "$B:FJQ49!JJ8@a?-=L!K(B")
  93. (defconst SJ3_TANCONV_EUC 112 "$B:FJQ49!JJ8@a?-=L!K(B")
  94. (defconst SJ3_KOUHO        54 "$B8uJd(B")
  95. (defconst SJ3_KOUHO_EUC   115 "$B8uJd(B")
  96. (defconst SJ3_KOUHOSU      55 "$B8uJd?t(B")
  97. (defconst SJ3_KOUHOSU_EUC 116 "$B8uJd?t(B")
  98. ;;;
  99. (defconst SJ3_STDY         61 "$BJ8@a3X=,(B")
  100. (defconst SJ3_END          62 "$BJ8@aD93X=,(B")
  101. (defconst SJ3_END_EUC     117 "$BJ8@aD93X=,(B")
  102. ;;;
  103. (defconst SJ3_WREG         71 "$BC18lEPO?(B")
  104. (defconst SJ3_WREG_EUC    118 "$BC18lEPO?(B")
  105. (defconst SJ3_WDEL         72 "$BC18l:o=|(B")
  106. (defconst SJ3_WDEL_EUC    119 "$BC18l:o=|(B")
  107. ;;;
  108. (defconst SJ3_MKDIC        81 "")
  109. (defconst SJ3_MKSTDY       82 "")
  110. (defconst SJ3_MKDIR        83 "")
  111. (defconst SJ3_ACCESS       84 "")
  112. ;;;
  113. (defconst SJ3_WSCH         91 "$BC18l8!:w(B")
  114. (defconst SJ3_WSCH_EUC    120 "$BC18l8!:w(B")
  115. (defconst SJ3_WNSCH        92 "")
  116. (defconst SJ3_WNSCH_EUC   121 "")
  117. ;;;
  118. (defconst SJ3_VERSION     103 "")
  119.  
  120. ;;;  Sj3 server version error
  121. (defconst SJ3_DifferentVersion 11 "")
  122. (defvar *sj3-current-server-version* nil)
  123.  
  124. (defvar sj3-server-buffer nil  "Buffer associated with Sj3 server process.")
  125.  
  126. (defvar sj3-server-process nil  "Sj3 Kana Kanji hankan process.")
  127.  
  128. (defvar sj3-command-tail-position nil)
  129. (defvar sj3-command-buffer nil)
  130.  
  131. (defvar sj3-result-buffer nil)
  132. (defvar sj3-henkan-string nil)
  133. (defvar sj3-bunsetu-suu   nil)
  134.  
  135. (defvar sj3-return-code nil)
  136. (defvar sj3-error-code nil)
  137.  
  138. (defvar sj3-stdy-size nil)
  139. (defvar sj3-user-dict-list nil)
  140. (defvar sj3-sys-dict-list nil)
  141. (defvar sj3-yomi-llist nil)
  142.  
  143. ;;;
  144. ;;;  Put data into buffer 
  145. ;;;
  146.  
  147. (defun sj3-put-4byte (integer)
  148.   (insert (logand 255 (ash integer -24))
  149.       (logand 255 (ash integer -16))
  150.       (logand 255 (ash integer -8))
  151.       (logand 255 (ash integer 0)) ))
  152.  
  153. (defun sj3-put-string (str)
  154.   (insert str 0))
  155.  
  156. (defun sj3-put-string* (str)
  157.   (let ((sstr (if (= *sj3-current-server-version* 2)
  158.           (encode-coding-string str 'euc-japan)
  159.         (encode-coding-string str 'sjis))))
  160.     (insert sstr 0)))
  161.  
  162. ;;;
  163. ;;; Get data from buffer
  164. ;;;
  165.  
  166. (defun sj3-get-4byte ()
  167.  
  168.   (let ((c 0) (point (point)))
  169.     ;;;(goto-char (point-min))
  170.     (while (< (point-max) (+ point 4))
  171.       (accept-process-output)
  172.       (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed.")))
  173.       (setq c (1+ c)))
  174.     (goto-char point))
  175.  
  176.   (let ((point (point)))
  177.     (if (not (or (and (= (char-after point) 0)
  178.               (< (char-after (+ point 1)) 128))
  179.          (and (= (char-after point) 255)
  180.               (<= 128 (char-after (+ point 1))))))
  181.     (error "sj3-get-4byte: integer range overflow."))
  182.     (prog1
  183.     (logior 
  184.      (lsh (char-after point)       24)
  185.      (lsh (char-after (+ point 1)) 16)
  186.      (lsh (char-after (+ point 2))  8)
  187.      (lsh (char-after (+ point 3))  0))
  188.       (goto-char (+ (point) 4)))))
  189.  
  190. (defun sj3-get-byte ()
  191.   (let ((c 0) (point (point)))
  192.     (while (< (point-max) (1+ point))
  193.       (accept-process-output)
  194.       (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed.")))
  195.       (setq c (1+ c)))
  196.     (goto-char point)
  197.     (prog1
  198.     (lsh (char-after point) 0)
  199.       (forward-char 1))))
  200.  
  201. (defun sj3-get-string ()
  202.   (let ((point (point)))
  203.     (skip-chars-forward "^\0")
  204.     (let ((c 0))
  205.       (while (eobp)
  206.     (accept-process-output)
  207.     (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed")))
  208.     (setq c (1+ c))
  209.     (skip-chars-forward "^\0")))
  210.     (prog1 
  211.     (buffer-substring point (point))
  212.       (forward-char 1))))
  213.  
  214. (defun sj3-get-string* ()
  215.   (let ((point (point)))
  216.     (sj3-get-convert-string)
  217.     (buffer-substring point (1- (point)))))
  218.  
  219. (defun sj3-get-convert-string ()
  220.   (let ((point (point)) (c 0) str)
  221.     (while (not (search-forward "\0" nil t))
  222.       (accept-process-output)
  223.       (goto-char point)
  224.       (if (= c 10) (if t (progn (sit-for 0) (setq c 0)) (error "Count exceed")))
  225.       (setq c (1+ c)))
  226.     (setq str (buffer-substring point (1- (point))))
  227.     (delete-region point (point))
  228.     (insert (if (= *sj3-current-server-version* 2)
  229.         (decode-coding-string str 'euc-japan)
  230.           (decode-coding-string str 'sjis)) 0)))
  231.  
  232. (defun sj3-get-stdy ()
  233.   (let ((c 0) (point (point)))
  234.     (while (< (point-max) (+ point sj3-stdy-size))
  235.       (accept-process-output)
  236.       (if (>= c 10) (progn (sit-for 0) (setq c 0))) ;;; delete error
  237.       (setq c (1+ c)))
  238.     (goto-char (+ point sj3-stdy-size))))
  239.  
  240. ;;;
  241. ;;; Sj3 Server Command Primitives
  242. ;;;
  243.  
  244. (defun sj3-command-start (command)
  245.   (set-buffer sj3-command-buffer)
  246.   (goto-char (point-min))
  247.   (if (not (= (point-max) (+ sj3-command-tail-position 1024)))
  248.       (error "sj3 command start error"))
  249.   (delete-region (point-min) sj3-command-tail-position)
  250.   (sj3-put-4byte command))
  251.  
  252. (defun sj3-command-reset ()
  253.   (save-excursion
  254.     (progn  
  255.       ;;; for Mule
  256.       (if (fboundp 'set-process-coding-system)
  257.       (set-process-coding-system sj3-server-process 'binary 'binary))
  258.       ;;; for Nemacs 3.0 and later
  259. ;;      (if (fboundp 'set-process-kanji-code)
  260. ;;         (set-process-kanji-code sj3-server-process 0))
  261.       (set-buffer sj3-command-buffer)
  262.       ;; (setq mc-flag nil)   ;;; for Mule
  263. ;;      (setq kanji-flag nil)
  264. ;;      (setq kanji-fileio-code 0)   ;;; for Nemacs 2.1
  265.       (buffer-disable-undo sj3-command-buffer)
  266.       (erase-buffer)
  267.       (setq sj3-command-tail-position (point-min))
  268.       (let ((max 1024) (i 0))
  269.     (while (< i max)
  270.       (insert 0)
  271.       (setq i (1+ i)))))))
  272.  
  273. (defun sj3-command-end ()
  274.   (set-buffer sj3-server-buffer)
  275.   (erase-buffer)
  276.   (set-buffer sj3-command-buffer)
  277.   (setq sj3-command-tail-position (point))
  278. ;;  (process-send-region sj3-server-process (point-min)
  279. ;;           (+ (point-min) (lsh (1+ (lsh (- (point) (point-min)) -10)) 10)))
  280.   (process-send-region sj3-server-process (point-min) (1+ (point)))
  281.   )
  282.  
  283. ;;;
  284. ;;; Sj3 Server Reply primitives
  285. ;;;
  286.  
  287. (defun sj3-get-result ()
  288.   (set-buffer sj3-server-buffer)
  289.   (condition-case ()
  290.       (accept-process-output sj3-server-process)
  291.     (error nil))
  292.   (goto-char (point-min)))
  293.  
  294. (defun sj3-get-return-code ()
  295.   (setq sj3-return-code (sj3-get-4byte))
  296.   (setq sj3-error-code  (if (= sj3-return-code 0) nil
  297.               (sj3-error-symbol sj3-return-code)))
  298.   (if sj3-error-code nil
  299.     sj3-return-code))
  300.  
  301. ;;;
  302. ;;; Sj3 Server Interface:  sj3-server-open
  303. ;;;
  304.  
  305. ;(defvar *sj3-server-max-kana-string-length* 1000)
  306. ;(defvar *sj3-server-max-bunsetu-suu* 1000)
  307.  
  308. (defvar *sj3-server-version* 2)
  309. (setq *sj3-server-version* 2)
  310. (defvar *sj3-program-name* "sj3-egg-m")
  311. (defvar *sj3-service-name* "sj3")
  312.  
  313. (defun sj3-server-open (server-host-name login-name)
  314.   (if (sj3-server-active-p) t
  315.      (let ((server_version *sj3-server-version*)
  316.        (sj3serv_name 
  317.        (if (or (null  server-host-name)
  318.            (equal server-host-name "")
  319.            (equal server-host-name "unix"))
  320.            (system-name)
  321.          server-host-name))
  322.       (user_name
  323.        (if (or (null login-name) (equal login-name ""))
  324.            (user-login-name)
  325.          login-name))
  326.       (host_name (system-name))
  327.       (program_name 
  328.        (format "%d.%s" 
  329.           (string-to-int (substring (make-temp-name "") 1 6))
  330.           *sj3-program-name*)))
  331.       (setq sj3-server-process 
  332.         (condition-case var
  333.         (open-network-stream "Sj3" " [Sj3 Output Buffer] "
  334.                      sj3serv_name *sj3-service-name* )
  335.           (error 
  336.             (cond((string-match "Unknown host" (car (cdr var)))
  337.               (setq sj3-error-code (list ':SJ3_UNKNOWN_HOST
  338.                          sj3serv_name)))
  339.              ((string-match "Unknown service" (car (cdr var)))
  340.               (setq sj3-error-code (list ':SJ3_UNKNOWN_SERVICE
  341.                          *sj3-service-name*)))
  342.              (t ;;; "Host ... not respoding"
  343.               (setq sj3-error-code ':SJ3_SOCK_OPEN_FAIL)))
  344.              nil)))
  345.       (if (null sj3-server-process) nil
  346.     (process-kill-without-query sj3-server-process)
  347.     (setq sj3-server-buffer (get-buffer " [Sj3 Output Buffer] "))
  348.     (setq sj3-command-buffer (get-buffer-create " [Sj3 Command Buffer] "))
  349.     (setq sj3-result-buffer (get-buffer-create " [Sj3 Result Buffer] "))
  350.  
  351.     (save-excursion 
  352.           ;;; for Mule
  353.       (if (fboundp 'set-process-coding-system)
  354.           (set-process-coding-system 
  355.            sj3-server-process 'binary 'binary))
  356.       ;;; for Nemacs 3.0 
  357. ;;      (if (fboundp 'set-process-kanji-code)
  358. ;;          (set-process-kanji-code sj3-server-process 0))
  359.       (progn
  360.         (set-buffer sj3-server-buffer)
  361. ;;        (setq mc-flag nil)   ;;; for Mule
  362. ;;        (setq kanji-flag nil)
  363.         ;;; for Nemacs 2.1
  364. ;;        (setq kanji-fileio-code 0) 
  365.         (buffer-disable-undo sj3-server-buffer)
  366.         )
  367.       (progn
  368.         (set-buffer sj3-result-buffer)
  369.         ;; (setq mc-flag nil)   ;;; for Mule
  370. ;;        (setq kanji-flag nil)
  371.         ;;; for Nemacs 2.1 
  372. ;;        (setq kanji-fileio-code 0)
  373.         (buffer-disable-undo sj3-result-buffer))
  374.       (progn  
  375.         (set-buffer sj3-command-buffer)
  376. ;;        (setq mc-flag nil)   ;;; for Mule
  377. ;;        (setq kanji-flag nil)
  378.         ;;; for Nemacs 2.1
  379. ;;        (setq kanji-fileio-code 0)
  380.         (buffer-disable-undo sj3-command-buffer)
  381.         (erase-buffer)
  382.         (setq sj3-command-tail-position (point-min))
  383.         (let ((max 1024) (i 0))
  384.           (while (< i max)
  385.         (insert 0)
  386.         (setq i (1+ i)))))
  387.       (sj3-clear-dict-list)
  388.       (sj3-command-start SJ3_OPEN)
  389.       (sj3-put-4byte server_version)
  390.       (sj3-put-string host_name)
  391.       (sj3-put-string user_name)
  392.       (sj3-put-string program_name)
  393.       (sj3-command-end)
  394.       (sj3-get-result)
  395.       (sj3-get-return-code)
  396.       (if (= sj3-return-code SJ3_DifferentVersion)
  397.           (progn (sj3-command-start SJ3_OPEN)
  398.                  (sj3-put-4byte 1)
  399.                  (sj3-put-string host_name)
  400.                  (sj3-put-string user_name)
  401.                  (sj3-put-string program_name)
  402.                  (sj3-command-end)
  403.                  (sj3-get-result)
  404.                  (sj3-get-return-code)
  405.                  (if (not (= sj3-return-code 0))
  406.                  (sj3-connection-error)
  407.                nil)
  408.              )
  409.         nil)
  410.       (if (or (= sj3-return-code 0) (> -1 sj3-return-code))
  411.           (progn  (setq *sj3-current-server-version* 1)
  412.                   (if (not (= sj3-return-code 0))
  413.                       (setq *sj3-current-server-version* (- 0 sj3-return-code))
  414.             nil)
  415.                       (sj3-get-stdy-size)
  416.               )
  417.         nil)
  418.       )))))
  419.  
  420. (defun sj3-server-active-p ()
  421.   (and sj3-server-process
  422.        (eq (process-status sj3-server-process) 'open)))
  423.  
  424. (defun sj3-connection-error ()
  425.   (setq sj3-error-code ':sj3-no-connection)
  426.   (setq sj3-return-code -1)
  427.   nil)
  428.  
  429. (defun sj3-zero-arg-command (op)
  430.   (if (sj3-server-active-p)
  431.       (progn
  432.     (sj3-command-start op)
  433.     (sj3-command-end)
  434.     (sj3-get-result)
  435.     (sj3-get-return-code))
  436.     (sj3-connection-error)))
  437.  
  438. (defun sj3-server-close ()
  439.   (let (dict-no)
  440.     (while (and (sj3-server-active-p) (setq dict-no (car sj3-sys-dict-list)))
  441.       (sj3-server-close-dict dict-no)
  442.       (setq sj3-sys-dict-list (cdr sj3-sys-dict-list)))
  443.     (while (and (sj3-server-active-p) (setq dict-no (car sj3-user-dict-list)))
  444.       (sj3-server-close-dict dict-no)
  445.       (setq sj3-user-dict-list (cdr sj3-user-dict-list)))
  446.     (sj3-clear-dict-list))
  447.   (sj3-server-close-stdy)
  448.   (sj3-zero-arg-command SJ3_CLOSE)
  449.   (if (sj3-server-active-p)
  450.       (delete-process sj3-server-process))
  451.   (if sj3-server-buffer
  452.       (kill-buffer sj3-server-buffer))
  453.   (if sj3-command-buffer
  454.       (kill-buffer sj3-command-buffer))
  455.   (if sj3-result-buffer
  456.       (kill-buffer sj3-result-buffer))
  457.   (setq sj3-server-process nil)
  458.   (setq sj3-server-buffer nil)
  459.   (setq sj3-command-buffer nil)
  460.   (setq sj3-result-buffer nil))
  461.  
  462. (defun sj3-clear-dict-list ()
  463.   (setq sj3-sys-dict-list nil)
  464.   (setq sj3-user-dict-list nil))
  465.  
  466. (or (fboundp 'si:kill-emacs)
  467.     (fset 'si:kill-emacs (symbol-function 'kill-emacs)))
  468.  
  469. (defun kill-emacs (&optional arg)
  470.   (interactive "P")
  471.   (if (sj3-server-active-p)
  472.       (progn
  473.     (sj3-server-close)))
  474.   (si:kill-emacs arg))
  475.  
  476. (defun sj3-get-stdy-size ()
  477.   (sj3-zero-arg-command SJ3_STDYSIZE)
  478.   (if (not (= sj3-return-code 0)) nil
  479.       (setq sj3-stdy-size (sj3-get-4byte))))
  480.  
  481. (defun sj3-put-stdy-dmy ()
  482.   (let ((i 0))
  483.     (while (< i sj3-stdy-size)
  484.       (insert 0)
  485.       (setq i (1+ i)))))
  486.  
  487. ;;; Sj3 Result Buffer's layout:
  488. ;;;
  489. ;;; { length:4  kana 0 kouhoSuu:4 kouhoNo:4
  490. ;;;   {studyData kanji 0 } ...
  491. ;;; }
  492. ;;;   0 0 0 0
  493.  
  494. (defun sj3-skip-length ()
  495.   (goto-char (+ (point) 4)))
  496.  
  497. (defun sj3-skip-4byte ()
  498.   (goto-char (+ (point) 4)))
  499.  
  500. (defun sj3-skip-yomi ()
  501.   (skip-chars-forward "^\0") (forward-char 1))
  502.  
  503. (defun sj3-skip-stdy ()
  504.   (goto-char (+ (point) sj3-stdy-size)))
  505.  
  506. ;;;
  507. ;;; entry function
  508. ;;;
  509. (defun sj3-server-henkan-begin (henkan-string)
  510.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  511.     (let ((inhibit-quit t) mb-str)
  512.       (save-excursion
  513.     (setq sj3-henkan-string henkan-string)
  514.     (if (= *sj3-current-server-version* 2)
  515.         (setq mb-str (encode-coding-string henkan-string 'euc-japan))
  516.         (setq mb-str (encode-coding-string henkan-string 'sjis))
  517.         )
  518.     (set-buffer sj3-result-buffer)
  519.     (erase-buffer)
  520.     (setq sj3-bunsetu-suu 0)
  521.     (setq sj3-yomi-llist nil)
  522.     (goto-char (point-min))
  523.     (if (= *sj3-current-server-version* 2)
  524.         (sj3-command-start SJ3_BEGIN_EUC)
  525.       (sj3-command-start SJ3_BEGIN)
  526.     )
  527.     (sj3-put-string mb-str)
  528.     (sj3-command-end)
  529.     (sj3-get-result)
  530.     (sj3-get-return-code)
  531.     (if (not (= sj3-return-code 0)) nil
  532.       (let ((yp 0) p0 yl offset)
  533.         (sj3-get-4byte)
  534.         (set-buffer sj3-result-buffer)
  535.         (delete-region (point) (point-max))
  536.         (setq p0 (point))
  537.         (insert sj3-henkan-string 0 0 0 0)
  538.         (goto-char p0)
  539.         (set-buffer sj3-server-buffer)
  540.         (while (> (setq yl (sj3-get-byte)) 0)
  541.           (let ((startp (point)) 
  542.             (ystr (substring mb-str yp (+ yp yl)))
  543.             endp)
  544.         (setq yp (+ yp yl))
  545.         (if (= *sj3-current-server-version* 2)
  546.             (setq yl (length (decode-coding-string ystr 'euc-japan)))
  547.           (setq yl (length (decode-coding-string ystr 'sjis)))
  548.         )
  549.         (sj3-get-stdy) ;;; skip study-data
  550.         (sj3-get-convert-string)
  551.         (setq endp (point))
  552.         (set-buffer sj3-result-buffer)
  553.         (setq p0 (point))
  554.         (forward-char yl)
  555.         (setq sj3-yomi-llist (append sj3-yomi-llist (list yl)))
  556.         (insert 0)  ;;; yomi
  557.         (sj3-put-4byte 1) ;;; kouho suu
  558.         (sj3-put-4byte 0) ;;; current kouho number
  559.         (insert-buffer-substring sj3-server-buffer startp endp)
  560.                           ;;; insert study data and kanji strings
  561.         (setq offset (- (point) p0))
  562.         (goto-char p0) (sj3-put-4byte offset)
  563.         (goto-char (+ (point) offset))
  564.         (setq sj3-return-code (1+ sj3-return-code))
  565.         (set-buffer sj3-server-buffer)))
  566.         (setq sj3-bunsetu-suu sj3-return-code)))))))
  567. ;;;
  568. ;;; entry function
  569. ;;;
  570. (defun sj3-server-henkan-quit () t)
  571.  
  572. (defun sj3-get-yomi-suu-org ()
  573.   (if (setq sj3-yomi-llist (cdr sj3-yomi-llist))
  574.       (car sj3-yomi-llist)
  575.     0))
  576.  
  577. ;;;
  578. ;;; entry function
  579. ;;;
  580. (defun sj3-server-henkan-end (bunsetu-no)
  581.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  582.     (let ((inhibit-quit t))
  583.       (save-excursion
  584.     (let (length ystr len kouho-no kouho-suu p0 (ylist nil))
  585.       (set-buffer sj3-result-buffer)
  586.       (goto-char (point-min))
  587.       (let ((max (if (and (integerp bunsetu-no)
  588.                   (<= 0 bunsetu-no)
  589.                   (<= bunsetu-no sj3-bunsetu-suu))
  590.              bunsetu-no
  591.                sj3-bunsetu-suu))
  592.         (i 0))
  593.         (while (< i max)
  594.           (setq length (sj3-get-4byte))
  595.           (setq p0 (point))
  596.           (setq ystr (sj3-get-string))
  597.           (setq len (1- (- (point) p0)))
  598.           (setq kouho-suu (sj3-get-4byte)) ;;; kouho suu
  599.           (setq kouho-no (sj3-get-4byte))
  600.           (if (and (> kouho-no 0)
  601.                (< kouho-no (- kouho-suu 2))
  602.                (> kouho-suu 3))
  603.           (sj3-server-b-study kouho-no))
  604.           (setq ylist (cons (list len ystr kouho-suu (point)) ylist))
  605.           (goto-char (+ p0 length))
  606.           (setq i (1+ i)))
  607.         (setq ylist (nreverse ylist))
  608.         (setq i 1)
  609.         (let ((yp 0) (op 0) (ydata (car ylist)) (ol (car sj3-yomi-llist)))
  610.           (while (< i max)
  611.         (let ((yl (nth 0 ydata)))
  612.           (setq ylist (cdr ylist))
  613.           (if (and (= yp op) (= yl ol))
  614.               (let ((pp (+ yp yl)))
  615.             (setq yp pp)
  616.             (setq op pp)
  617.             (setq ydata (car ylist))
  618.             (setq ol (sj3-get-yomi-suu-org)))
  619.             (let ((str (nth 1 ydata))
  620.               (ent (nth 2 ydata)))
  621.               (setq ydata (car ylist))
  622.               (setq yp (+ yp yl))
  623.               (while (< op yp)
  624.             (setq op (+ op ol))
  625.             (setq ol (sj3-get-yomi-suu-org)))
  626.               (if (or (= ent 2) (= (nth 2 ydata) 2)) nil
  627.             (let ((sub (- op yp)) (yl1 (nth 0 ydata)))
  628.               (set-buffer sj3-result-buffer)
  629.               (goto-char (nth 3 ydata))
  630.               (sj3-server-cl-study str (nth 1 ydata))
  631.               (if (and (not (= sub yl1)) (not (= sub (- yl1 ol))))
  632.                   nil
  633.                 (setq i (1+ i))
  634.                 (setq ylist (cdr ylist))
  635.                 (setq ydata (car ylist))
  636.                 (if (= sub yl1) nil
  637.                   (setq op (+ op ol))
  638.                   (setq ol (sj3-get-yomi-suu-org))))))))
  639.               (setq i (1+ i))))
  640.         (if (or (null ydata) (= (nth 0 ydata) ol) (= (nth 2 ydata) 2))
  641.         sj3-return-code
  642.           (goto-char (nth 3 ydata))
  643.           (sj3-server-cl-study (nth 1 ydata) "")))))))))
  644.  
  645. (defun sj3-server-cl-study (str1 str2)
  646.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  647.     (save-excursion
  648.       (if (= *sj3-current-server-version* 2)
  649.       (sj3-command-start SJ3_END_EUC)
  650.     (sj3-command-start SJ3_END))
  651.       (sj3-put-string* str1)
  652.       (sj3-put-string* str2)
  653.       (if (string= str2 "") (sj3-put-stdy-dmy)
  654.     (let (p0)
  655.       (set-buffer sj3-result-buffer)
  656.       (setq p0 (point))
  657.       (set-buffer sj3-command-buffer)
  658.       (insert-buffer-substring sj3-result-buffer p0 (+ p0 sj3-stdy-size))))
  659.       (sj3-command-end)
  660.       (sj3-get-result)
  661.       (sj3-get-return-code))))
  662.     
  663. (defun sj3-server-b-study (no)
  664.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  665.     (save-excursion
  666.       (let ((i 0) p0)
  667.     (set-buffer sj3-result-buffer)
  668.     (while (< i no)
  669.       (sj3-skip-stdy)
  670.       (sj3-skip-yomi)
  671.       (setq i (1+ i)))
  672.     (setq p0 (point))
  673.     (sj3-command-start SJ3_STDY)
  674.     (insert-buffer-substring sj3-result-buffer p0 (+ p0 sj3-stdy-size))
  675.     (sj3-command-end)
  676.     (sj3-get-result)
  677.     (sj3-get-return-code)))))
  678.  
  679. (defun sj3-result-goto-bunsetu (bunsetu-no)
  680.   (goto-char (point-min))
  681.   (let (length (i 0))
  682.     (while (< i bunsetu-no)
  683.       (setq length (sj3-get-4byte))
  684.       (goto-char (+ (point) length))
  685.       (setq i (1+ i)))))
  686.           
  687. ;;;
  688. ;;; entry function
  689. ;;;
  690. (defun sj3-server-henkan-kakutei (bunsetu-no jikouho-no)
  691.   (cond((not (sj3-server-active-p)) (sj3-connection-error))
  692.        ((or (< bunsetu-no 0) (<= sj3-bunsetu-suu bunsetu-no))
  693.     nil)
  694.        (t 
  695.     (let ((inhibit-quit t))
  696.       (save-excursion
  697.         (set-buffer sj3-result-buffer)
  698.         (let (kouho-suu)
  699.           (sj3-result-goto-bunsetu bunsetu-no)
  700.           (sj3-skip-length)
  701.           (sj3-skip-yomi)
  702.           (setq kouho-suu (sj3-get-4byte))
  703.           (if (or (< jikouho-no 0) (<= kouho-suu jikouho-no)) nil
  704.         (delete-char 4) (sj3-put-4byte jikouho-no)
  705.         t)))))))
  706.  
  707. ;;;
  708. ;;; entry function
  709. ;;;
  710. (defun sj3-server-henkan-next (bunsetu-no)
  711.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  712.     (let ((inhibit-quit t))
  713.       (save-excursion
  714.     (let (p0 p1 kouho-suu length ystr)
  715.       (set-buffer sj3-result-buffer)
  716.       (sj3-result-goto-bunsetu bunsetu-no)
  717.       (sj3-skip-length)
  718.       (setq p0 (point))
  719.       (setq ystr (sj3-get-string))
  720.       (setq p1 (point))
  721.       (setq kouho-suu (sj3-get-4byte))
  722.       (if (> kouho-suu 1) t
  723.         (let ((ksuu (sj3-server-henkan-kouho ystr)) (startp 0) endp)
  724.           (if (< ksuu 0) sj3-return-code
  725.         (let (kanji)
  726.           (set-buffer sj3-result-buffer)
  727.           (sj3-skip-4byte)
  728.           (sj3-skip-stdy)
  729.           (setq kanji (sj3-get-string))
  730.           (if (> ksuu 1)
  731.               (let ((i 1))
  732.             (set-buffer sj3-server-buffer)
  733.             (sj3-get-4byte)
  734.             (setq startp (point))
  735.             (sj3-get-stdy)
  736.             (let ((kkanji (sj3-get-string*)))
  737.               (if (equal kanji kkanji)
  738.                   (setq startp (point))
  739.                 (setq ksuu (1+ ksuu))
  740.                 (setq i (1+ i))))
  741.             (while (< i ksuu)
  742.               (sj3-get-4byte)
  743.               (delete-char -4)
  744.               (sj3-get-stdy)
  745.               (sj3-get-convert-string)
  746.               (setq i (1+ i)))
  747.             (setq endp (point))))
  748.           (set-buffer sj3-result-buffer)
  749.           (if (> startp 0)
  750.               (insert-buffer-substring sj3-server-buffer startp endp))
  751.           (sj3-put-kata ystr)
  752.           (insert ystr 0)
  753.           (setq length (- (point) p0))
  754.           (goto-char p1)
  755.           (delete-char 4)
  756.           (if (<= ksuu 0)(sj3-put-4byte 3) ;;;
  757.             (sj3-put-4byte (+ ksuu 2)))    ;;; put kouho-suu 
  758.           (goto-char p0)
  759.           (delete-char -4)
  760.           (sj3-put-4byte length))
  761.         t))))))))
  762.  
  763. (defun sj3-server-henkan-kouho (str)
  764.   (if (not (sj3-server-active-p)) -1
  765.     (let ((mb-str (if (= *sj3-current-server-version* 2)
  766.               (encode-coding-string str 'euc-japan)
  767.             (encode-coding-string str 'sjis)))
  768.       len kouho-suu)
  769.       (setq len (length mb-str))
  770.       (setq kouho-suu (sj3-server-henkan-kouho-suu len mb-str))
  771.       (if (<= kouho-suu 0) nil
  772.     (if (= *sj3-current-server-version* 2)
  773.         (sj3-command-start SJ3_KOUHO_EUC)
  774.       (sj3-command-start SJ3_KOUHO))
  775.     (sj3-put-4byte len)
  776.     (sj3-put-string mb-str)
  777.     (sj3-command-end)
  778.     (sj3-get-result)
  779.     (sj3-get-return-code)
  780.     (if (not (= sj3-return-code 0)) -1))
  781.       kouho-suu)))
  782.  
  783. (defun sj3-put-kata (str)
  784.   (setq str (copy-sequence str))
  785.   (let ((i 0) (len (length str)) ch)
  786.     (while (< i len)
  787.       (setq ch (aref str i))
  788.       (aset str i
  789.         (if (and (/= ?$B!<(B ch)
  790.              (string-match "\\cH" (char-to-string ch)))
  791.         (make-char (find-charset 'japanese-jisx0208) 37
  792.                (char-octet ch 1))
  793.           ch))
  794.       (incf i))
  795.     (insert str 0)))
  796.  
  797. (defun sj3-server-henkan-kouho-suu (yomi-length yomi)
  798.   (if (not (sj3-server-active-p)) -1
  799.     (save-excursion
  800.       (if (= *sj3-current-server-version* 2)
  801.       (sj3-command-start SJ3_KOUHOSU_EUC)
  802.     (sj3-command-start SJ3_KOUHOSU))
  803.       (sj3-put-4byte yomi-length)
  804.       (sj3-put-string yomi)
  805.       (sj3-command-end)
  806.       (sj3-get-result)
  807.       (sj3-get-return-code)
  808.       (if (not (= sj3-return-code 0)) -1
  809.     (sj3-get-4byte)))))
  810.  
  811. ;;;
  812. ;;; entry function
  813. ;;;
  814. (defun sj3-server-bunsetu-henkou (bunsetu-no bunsetu-length)
  815.   (cond((not (sj3-server-active-p)) (sj3-connection-error))
  816.        ((or (< bunsetu-no 0) (<= sj3-bunsetu-suu bunsetu-no))
  817.     nil)
  818.        (t
  819.     (let ((inhibit-quit t))
  820.       (save-excursion
  821.         (let (yp0 p0 p1 str len1 len2 bunsetu-suu (bno bunsetu-no))
  822.           (set-buffer sj3-result-buffer)
  823.           (setq yp0 (sj3-yomi-point bunsetu-no))
  824.           (setq p0 (point))
  825.           (setq str (sj3-get-yomi* yp0 bunsetu-length))
  826.           (setq len1 (length str))
  827.           (setq bunsetu-suu sj3-bunsetu-suu)
  828.           (let (point length)
  829.         (setq len2 len1)
  830.         (while (and (< bno sj3-bunsetu-suu) (> len2 0))
  831.           (setq length (sj3-get-4byte))
  832.           (setq point (point))
  833.           (skip-chars-forward "^\0")
  834.           (setq len2 (- len2 (- (point) point)))
  835.           (goto-char (+ point length))
  836.           (setq bno (1+ bno))))
  837.           (setq p1 (point))
  838.           (delete-region p0 p1)
  839.           (setq sj3-bunsetu-suu (- sj3-bunsetu-suu (- bno bunsetu-no)))
  840.           (if (= (sj3-put-tanconv str) 0)
  841.           (if (not (= len2 0))
  842.               (let ((len (- 0 len2)) (yp1 (+ yp0 len1))
  843.                 ystr mb-str)
  844.             (if (or (> bno (1+ bunsetu-no)) (= bno bunsetu-suu))
  845.                 (setq ystr (sj3-get-yomi yp1 len))
  846.               (let (ll length i)
  847.                 (set-buffer sj3-result-buffer)
  848.                 (setq p0 (point))
  849.                 (setq length (sj3-get-4byte))
  850.                 (skip-chars-forward "^\0")
  851.                 (setq ll (+ len (- (point) (+ p0 4))))
  852.                 (setq p1 (+ p0 (+ length 4)))
  853.                 (setq ystr (sj3-get-yomi yp1 ll))
  854.                 (setq mb-str (if (= *sj3-current-server-version* 2)
  855.                          (encode-coding-string ystr 'euc-japan)
  856.                        (encode-coding-string ystr 'sjis)))
  857.                 (setq i (sj3-server-henkan-kouho-suu 
  858.                      (length mb-str) mb-str))
  859.                 (set-buffer sj3-result-buffer)
  860.                 (if (= i 0) (setq ystr (sj3-get-yomi yp1 len))
  861.                   (delete-region p0 p1)
  862.                   (setq sj3-bunsetu-suu (1- sj3-bunsetu-suu))
  863.                   (setq len ll))
  864.                 (goto-char p0)))
  865.             (sj3-put-tanconv ystr))))
  866.           (if (= sj3-return-code -1) nil
  867.         sj3-bunsetu-suu)))))))
  868.  
  869. (defun sj3-put-tanconv (str)
  870.   (let ((point (point)) len ksuu
  871.     (mb-str (if (= *sj3-current-server-version* 2)
  872.             (encode-coding-string str 'euc-japan)
  873.           (encode-coding-string str 'sjis))))
  874.     (setq len (length mb-str))
  875.     (setq ksuu (sj3-server-henkan-kouho-suu len mb-str))
  876.     (if (>= ksuu 0)
  877.     (let (offset)
  878.       (set-buffer sj3-result-buffer)
  879.       (insert str 0)
  880.       (if (or (= ksuu 0)
  881.           (not (sj3-server-tanconv len mb-str)))
  882.           (put-kata-and-hira str)
  883.         (let (p0 p1)
  884.           (set-buffer sj3-result-buffer)
  885.           (sj3-put-4byte 1)
  886.           (sj3-put-4byte 0)
  887.           (set-buffer sj3-server-buffer)
  888.           (sj3-get-4byte)
  889.           (setq p0 (point))
  890.           (sj3-get-stdy)
  891.           (sj3-get-convert-string)
  892.           (setq p1 (point))
  893.           (set-buffer sj3-result-buffer)
  894.           (insert-buffer-substring sj3-server-buffer p0 p1)))
  895.       (set-buffer sj3-result-buffer)
  896.       (setq offset (- (point) point))
  897.       (goto-char point) (sj3-put-4byte offset)
  898.       (goto-char (+ (point) offset))
  899.       (setq sj3-bunsetu-suu (1+ sj3-bunsetu-suu))))
  900.     sj3-return-code))
  901.             
  902. (defun sj3-server-tanconv (len str)
  903.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  904.     (let ((inhibit-quit t))
  905.       (if (= *sj3-current-server-version* 2)
  906.       (sj3-command-start SJ3_TANCONV_EUC)
  907.     (sj3-command-start SJ3_TANCONV))
  908.       (sj3-put-4byte len)
  909.       (sj3-put-string str)
  910.       (sj3-command-end)
  911.       (sj3-get-result)
  912.       (sj3-get-return-code))))
  913.  
  914. (defun put-kata-and-hira (str)
  915.   (sj3-put-4byte 2)
  916.   (sj3-put-4byte 0)
  917.   (sj3-put-stdy-dmy)
  918.   (sj3-put-kata str)
  919.   (insert str 0))
  920.  
  921. (defun sj3-get-yomi (offset length)
  922.   (substring sj3-henkan-string offset (+ offset length)))
  923.  
  924. (defun sj3-get-yomi* (offset bunsetu-length)
  925.   (let ((i 0) (c offset))
  926.     (while (< i bunsetu-length)
  927.     (let ((ch (substring sj3-henkan-string c (1+ c))))
  928.       (if (string= ch "\222");;lc-jp
  929.           (setq c (+ 3 c))
  930.       (setq c (1+ c)))
  931.       (setq i (1+ i))))
  932.     (substring sj3-henkan-string offset c)))
  933.       
  934. (defun sj3-bunsetu-suu () sj3-bunsetu-suu)
  935.  
  936. (defun sj3-bunsetu-kanji (bunsetu-no &optional buffer)
  937.   (let ((savebuffer (current-buffer)))
  938.     (unwind-protect 
  939.     (progn
  940.       (set-buffer sj3-result-buffer)
  941.       (if (or (< bunsetu-no 0)
  942.           (<= sj3-bunsetu-suu bunsetu-no))
  943.           nil
  944.         (sj3-result-goto-bunsetu bunsetu-no)
  945.         (sj3-skip-length)
  946.         (sj3-skip-yomi)
  947.  
  948.         (let ((i 0) 
  949.           (rksuu (- (sj3-get-4byte) 2)) ;;; real kouho-suu
  950.           (max (sj3-get-4byte)))       ;;; kouho-number
  951.           (sj3-skip-stdy)
  952.           (while (< i max)
  953.         (sj3-skip-yomi)
  954.         (setq i (1+ i))
  955.         (if (< i rksuu)
  956.             (sj3-skip-stdy))))
  957.         
  958.         (let ( p1 p2 )
  959.           (setq p1 (point))
  960.           (skip-chars-forward "^\0") (setq p2 (point))
  961.           (forward-char 1)
  962.           (if (null buffer)
  963.           (concat (buffer-substring p1 p2))
  964.         (set-buffer buffer)
  965.         (insert-buffer-substring sj3-result-buffer p1 p2)
  966.         nil))))
  967.       (set-buffer savebuffer))))
  968.  
  969. (defun sj3-bunsetu-kanji-length (bunsetu-no)
  970.   (save-excursion
  971.     (set-buffer sj3-result-buffer)
  972.     (if (or (< bunsetu-no 0)
  973.         (<= sj3-bunsetu-suu bunsetu-no))
  974.     nil
  975.       (sj3-result-goto-bunsetu bunsetu-no)
  976.       (sj3-skip-length)
  977.       (sj3-skip-yomi)
  978.  
  979.       (let ((i 0) 
  980.         (rksuu (- (sj3-get-4byte) 2)) ;;; real kouho-suu
  981.         (max (sj3-get-4byte)))        ;;; kouho-number
  982.     (sj3-skip-stdy)
  983.     (while (< i max)
  984.       (sj3-skip-yomi)
  985.       (setq i (1+ i))
  986.       (if (< i rksuu)
  987.           (sj3-skip-stdy))))
  988.         
  989.       (let ( p1 p3 )
  990.     (setq p1 (point))
  991.     (skip-chars-forward "^\0")
  992.     (setq p3 (point))
  993.     (- p3 p1)))))
  994.  
  995. (defun sj3-bunsetu-yomi-moji-suu (bunsetu-no)
  996.   (save-excursion
  997.     (set-buffer sj3-result-buffer)
  998.     (if (or (<  bunsetu-no 0)
  999.         (<= sj3-bunsetu-suu bunsetu-no))
  1000.     nil
  1001.       (sj3-result-goto-bunsetu bunsetu-no)
  1002.       (sj3-skip-length)
  1003. ;;      (1- (- (point-max) (point))))))
  1004.       (let ((c 0))
  1005.     (while (not (char-equal (int-to-char 0) (char-after)))
  1006.       (forward-char 1)
  1007.           (setq c (1+ c)))
  1008.         c))))
  1009.  
  1010. (defun sj3-yomi-point (bunsetu-no)
  1011.   (let ((i 0) (len 0) point length)
  1012.     (goto-char (point-min))
  1013.     (while (< i bunsetu-no)
  1014.       (setq length (sj3-get-4byte))
  1015.       (setq point (point))
  1016.       (skip-chars-forward "^\0")
  1017.       (setq len (+ len (- (point) point)))
  1018.       (goto-char (+ point length))
  1019.       (setq i (1+ i)))
  1020.       len))
  1021.  
  1022. (defun sj3-bunsetu-yomi (bunsetu-no &optional buffer)
  1023.   (let ((savebuff (current-buffer)))
  1024.     (unwind-protect 
  1025.     (progn
  1026.       (set-buffer sj3-result-buffer)
  1027.       (if (or (<  bunsetu-no 0)
  1028.           (<= sj3-bunsetu-suu bunsetu-no))
  1029.           nil
  1030.         (sj3-result-goto-bunsetu bunsetu-no)
  1031.         (sj3-skip-length)
  1032.         (let (p1 p2 )
  1033.           (setq p1 (point))
  1034.           (skip-chars-forward "^\0")
  1035.           (if (null buffer ) (buffer-substring p1 (point))
  1036.         (setq p2 (point))
  1037.         (set-buffer buffer)
  1038.         (insert-buffer-substring sj3-result-buffer p1 p2)
  1039.         t))))
  1040.       (set-buffer savebuff))))
  1041.  
  1042. (defun sj3-bunsetu-yomi-equal (bunsetu-no yomi)
  1043.   (save-excursion
  1044.     (set-buffer sj3-result-buffer)
  1045.       (if (or (<  bunsetu-no 0)
  1046.         (<= sj3-bunsetu-suu bunsetu-no))
  1047.     nil
  1048.       (sj3-result-goto-bunsetu bunsetu-no)
  1049.       (sj3-skip-length)
  1050.       (looking-at (regexp-quote yomi))))) ;93.4.6 by T.Saneto
  1051.  
  1052. (defun sj3-bunsetu-kouho-suu (bunsetu-no)
  1053.   (save-excursion
  1054.     (set-buffer sj3-result-buffer)
  1055.     (if (or (<  bunsetu-no 0)
  1056.         (<= sj3-bunsetu-suu bunsetu-no))
  1057.     nil
  1058.       (sj3-result-goto-bunsetu bunsetu-no)
  1059.       (sj3-skip-length)
  1060.       (sj3-skip-yomi)
  1061.       (sj3-get-4byte))))
  1062.  
  1063. (defun sj3-bunsetu-kouho-list (bunsetu-no)
  1064.   (save-excursion
  1065.     (set-buffer sj3-result-buffer)
  1066.     (if (or (<  bunsetu-no 0)
  1067.         (<= sj3-bunsetu-suu bunsetu-no))
  1068.     nil
  1069.       (sj3-result-goto-bunsetu bunsetu-no)
  1070.       (sj3-skip-length)
  1071.       (sj3-skip-yomi)
  1072.       (let ((max (sj3-get-4byte)) (i 0) (result nil) p0)
  1073.     (sj3-skip-4byte) ;;; current kouhou number
  1074.     (sj3-skip-stdy)
  1075.     (while (< i max)
  1076.       (setq p0 (point))
  1077.       (skip-chars-forward "^\0")
  1078.       (setq result
  1079.         (cons (concat (buffer-substring p0 (point)))
  1080.               result))
  1081.       (forward-char 1)
  1082.       (setq i (1+ i))
  1083.       (if (< i (- max 2))
  1084.           (sj3-skip-stdy)))
  1085.     (nreverse result)))))
  1086.  
  1087. (defun sj3-bunsetu-kouho-number (bunsetu-no)
  1088.   (save-excursion
  1089.     (set-buffer sj3-result-buffer)
  1090.     (if (or (<  bunsetu-no 0)
  1091.         (<= sj3-bunsetu-suu bunsetu-no))
  1092.     nil
  1093.       (sj3-result-goto-bunsetu bunsetu-no)
  1094.       (sj3-skip-length)
  1095.       (sj3-skip-yomi)
  1096.       (sj3-skip-4byte)
  1097.       (sj3-get-4byte)))
  1098.   )
  1099.  
  1100. (defun sj3-simple-command (op arg)
  1101.   (if (sj3-server-active-p)
  1102.       (let ((inhibit-quit t))
  1103.     (progn
  1104.       (sj3-command-start op)
  1105.       (sj3-put-4byte arg)
  1106.       (sj3-command-end)
  1107.       (sj3-get-result)
  1108.       (sj3-get-return-code)))
  1109.     (sj3-connection-error)))
  1110.  
  1111. (defun sj3-server-open-dict (dict-file-name password)
  1112.   (if (not (sj3-server-active-p))(sj3-connection-error)
  1113.     (let ((inhibit-quit t))
  1114.       (save-excursion
  1115.         (sj3-command-start SJ3_DICADD)
  1116.     (sj3-put-string dict-file-name)
  1117.     (if (stringp password)
  1118.         (sj3-put-string password)
  1119.       (sj3-put-string 0))
  1120.     (sj3-command-end)
  1121.     (sj3-get-result)
  1122.     (sj3-get-return-code)
  1123.     (if (not (= sj3-return-code 0)) nil
  1124.       (let ((dict-no (sj3-get-4byte)))
  1125.         (if (stringp password)
  1126.         (setq sj3-user-dict-list
  1127.               (append sj3-user-dict-list (list dict-no)))
  1128.           (setq sj3-sys-dict-list
  1129.             (append sj3-sys-dict-list (list dict-no))))
  1130.         dict-no))))))
  1131.  
  1132. (defun sj3-server-close-dict (dict-no)
  1133.   (if (not (sj3-server-active-p))(sj3-connection-error)
  1134.     (let ((inhibit-quit t))
  1135.       (save-excursion
  1136.     (sj3-command-start SJ3_DICDEL)
  1137.     (sj3-put-4byte dict-no)
  1138.     (sj3-command-end)
  1139.     (sj3-get-result)
  1140.     (sj3-get-return-code)))))
  1141.  
  1142. (defun sj3-server-make-dict (dict-file-name)
  1143.   (if (not (sj3-server-active-p))(sj3-connection-error)
  1144.     (let ((inhibit-quit t))
  1145.       (save-excursion
  1146.     (sj3-command-start SJ3_MKDIC)
  1147.     (sj3-put-string dict-file-name)
  1148.     (sj3-put-4byte 2048)  ;;; Index length
  1149.     (sj3-put-4byte 2048)  ;;; Length
  1150.     (sj3-put-4byte 256)   ;;; Number
  1151.     (sj3-command-end)
  1152.     (sj3-get-result)
  1153.     (sj3-get-return-code)))))
  1154.  
  1155. (defun sj3-server-open-stdy (stdy-file-name)
  1156.   (if (not (sj3-server-active-p))(sj3-connection-error)
  1157.     (let ((inhibit-quit t))
  1158.       (save-excursion
  1159.     (sj3-command-start SJ3_OPENSTDY)
  1160.     (sj3-put-string stdy-file-name)
  1161.     (sj3-put-string 0)
  1162.     (sj3-command-end)
  1163.     (sj3-get-result)
  1164.     (sj3-get-return-code)))))
  1165.  
  1166. (defun sj3-server-close-stdy ()
  1167.   (sj3-zero-arg-command SJ3_CLOSESTDY))
  1168.  
  1169. (defun sj3-server-make-stdy (stdy-file-name)
  1170.   (if (not (sj3-server-active-p))(sj3-connection-error)
  1171.     (let ((inhibit-quit t))
  1172.       (save-excursion
  1173.     (sj3-command-start SJ3_MKSTDY)
  1174.     (sj3-put-string stdy-file-name)
  1175.     (sj3-put-4byte 2048)  ;;; Number
  1176.     (sj3-put-4byte 1)     ;;; Step
  1177.     (sj3-put-4byte 2048)  ;;; Length
  1178.     (sj3-command-end)
  1179.     (sj3-get-result)
  1180.     (sj3-get-return-code)))))
  1181.  
  1182. (defun sj3-server-dict-add (dictno kanji yomi bunpo)
  1183.   (if (not (sj3-server-active-p))(sj3-connection-error) 
  1184.     (let ((inhibit-quit t))
  1185.       (save-excursion
  1186.     (if (= *sj3-current-server-version* 2)
  1187.         (sj3-command-start SJ3_WREG_EUC)
  1188.       (sj3-command-start SJ3_WREG))
  1189.     (sj3-put-4byte dictno)
  1190.     (sj3-put-string* yomi)
  1191.     (sj3-put-string* kanji)
  1192.     (sj3-put-4byte bunpo)
  1193.     (sj3-command-end)
  1194.     (sj3-get-result)
  1195.     (sj3-get-return-code)))))
  1196.  
  1197. (defun sj3-server-dict-delete (dictno kanji yomi bunpo)
  1198.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  1199.     (let ((inhibit-quit t))
  1200.       (save-excursion
  1201.     (if (= *sj3-current-server-version* 2)
  1202.         (sj3-command-start SJ3_WDEL_EUC)
  1203.       (sj3-command-start SJ3_WDEL))
  1204.     (sj3-put-4byte dictno)
  1205.     (sj3-put-string* yomi)
  1206.     (sj3-put-string* kanji)
  1207.     (sj3-put-4byte bunpo)
  1208.     (sj3-command-end)
  1209.     (sj3-get-result)
  1210.     (sj3-get-return-code)))))
  1211.  
  1212. (defun sj3-server-dict-info (dict-no)
  1213.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  1214.     (let ((inhibit-quit t))
  1215.       (save-excursion
  1216.     (let ((result nil))
  1217.       (set-buffer sj3-server-buffer)
  1218.       (if (= *sj3-current-server-version* 2)
  1219.           (sj3-simple-command SJ3_WSCH_EUC dict-no)
  1220.         (sj3-simple-command SJ3_WSCH dict-no))
  1221.       (while (= sj3-return-code 0)
  1222.         ;;; (sj3-get-4byte)
  1223.         (setq result (cons (list (sj3-get-string*)
  1224.                     (sj3-get-string*) (sj3-get-4byte)) result))
  1225.         (if (= *sj3-current-server-version* 2)
  1226.         (sj3-simple-command SJ3_WNSCH_EUC dict-no)
  1227.           (sj3-simple-command SJ3_WNSCH dict-no)))
  1228.       (if (= sj3-return-code 111)
  1229.           (setq sj3-error-code nil))
  1230.       (nreverse result))))))
  1231.  
  1232. (defun sj3-server-make-directory (dir-name)
  1233.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  1234.     (let ((inhibit-quit t))
  1235.       (save-excursion
  1236.     (sj3-command-start SJ3_MKDIR)
  1237.     (sj3-put-string dir-name)
  1238.     (sj3-command-end)
  1239.     (sj3-get-result)
  1240.     (sj3-get-return-code)))))
  1241.  
  1242. (defun sj3-server-file-access (file-name access-mode)
  1243.   (if (not (sj3-server-active-p)) (sj3-connection-error)
  1244.     (let ((inhibit-quit t))
  1245.       (save-excursion
  1246.     (sj3-command-start SJ3_ACCESS)
  1247.     (sj3-put-string file-name)
  1248.     (sj3-put-4byte access-mode)
  1249.     (sj3-command-end)
  1250.     (sj3-get-result)
  1251.     (setq sj3-error-code nil)
  1252.     (sj3-get-4byte)))))
  1253.  
  1254. (defun sj3_lock ()
  1255.   (sj3-zero-arg-command SJ3_LOCK))
  1256.  
  1257. (defun sj3_unlock ()
  1258.   (sj3-zero-arg-command SJ3_UNLOCK))
  1259.  
  1260. (defun sj3_version ()
  1261.   (sj3-zero-arg-command SJ3_VERSION))
  1262.  
  1263. (defconst *sj3-error-alist*
  1264.   '(
  1265.     (1 :SJ3_SERVER_DEAD
  1266.        "$B%5!<%P$,;`$s$G$$$^$9!#(B")
  1267.     (2 :SJ3_SOCK_OPEN_FAIL
  1268.        "socket$B$N(Bopen$B$K<:GT$7$^$7$?!#(B")
  1269.     (6 :SJ3_ALLOC_FAIL
  1270.        "$B%a%b%j(Balloc$B$G<:GT$7$^$7$?!#(B")
  1271.     (7 :SJ3_ILLEGAL_COMMAND
  1272.        "$B%3%^%s%I$,4V0c$C$F$$$k(B")
  1273.     (12 :SJ3_BAD_HOST
  1274.     " $B%[%9%HL>$,$J$$(B ")
  1275.     (13 :SJ3_BAD_USER
  1276.     " $B%f!<%6L>$,$J$$(B ")
  1277.     (31 :SJ3_NOT_A_DICT
  1278.     "$B@5$7$$<-=q$G$O$"$j$^$;$s!#(B")
  1279.     (35 :SJ3_NO_EXIST     
  1280.     "$B%U%!%$%k$,B8:_$7$^$;$s!#(B")
  1281.     (37 :SJ3_OPENF_ERR
  1282.     "$B%U%!%$%k$,%*!<%W%s$G$-$^$;$s!#(B")
  1283.     (39 :SJ3_PARAMR
  1284.     "$B%U%!%$%k$NFI$_9~$_8"8B$,$"$j$^$;$s!#(B")
  1285.     (40 :SJ3_PARAMW
  1286.     "$B%U%!%$%k$N=q$-9~$_8"8B$,$"$j$^$;$s!#(B")
  1287.     (71 :SJ3_NOT_A_USERDICT
  1288.     "$B;XDj$5$l$F<-=q$O!"%f!<%6!<<-=q$G$O$"$j$^$;$s!#(B")
  1289.     (72 :SJ3_RDONLY
  1290.     "$B%j!<%I%*%s%j!<$N<-=q$KEPO?$7$h$&$H$7$^$7$?!#(B")
  1291.     (74 :SJ3_BAD_YOMI
  1292.     "$BFI$_$KITE,Ev$JJ8;z$,4^$^$l$F$$$^$9!#(B")
  1293.     (75 :SJ3_BAD_KANJI
  1294.     "$B4A;z$KITE,Ev$JJ8;z$,4^$^$l$F$$$^$9!#(B")
  1295.     (76 :SJ3_BAD_HINSHI
  1296.     "$B;XDj$5$l$?IJ;lHV9f$,$"$j$^$;$s!#(B")
  1297.     (82 :SJ3_WORD_ALREADY_EXIST
  1298.     "$B;XDj$5$l$?C18l$O$9$G$KB8:_$7$F$$$^$9!#(B")
  1299.     (84 :SJ3_JISHOTABLE_FULL
  1300.     "$B<-=q%F!<%V%k$,0lGU$G$9!#(B")
  1301.     (92 :SJ3_WORD_NO_EXIST
  1302.     "$B;XDj$5$l$?C18l$,B8:_$7$^$;$s!#(B")
  1303.     (102 :SJ3_MKDIR_FAIL
  1304.     " $B%G%#%l%/%H%j$r:n$jB;$J$C$?(B ")
  1305.     ))
  1306.  
  1307. (defun sj3-error-symbol (code)
  1308.   (let ((pair (assoc code *sj3-error-alist*)))
  1309.     (if (null pair)
  1310.     (list ':sj3-unknown-error-code code)
  1311.       (car (cdr pair)))))
  1312.  
  1313.